Problema 18 (Timisoara, pregatire, febr. 1996)

   Se da un numar k>1 si un sir de caractere. Sa se verifice daca sirul are
k subsiruri adiacente identice.
   Daca da sa se afiseze DA pe o linie si pe linia/liniile urmatoare toate
subsirurile care verifica aceasta conditie, precizand subsirul si pozitia
primei sale aparitii.
   Daca nu exista nici un subsir care sa verifice conditia sa se afiseze pe
o linie NU.
   Datele  de intrare  sunt date in fisierul int.txt astfel: o linie
contine numarul k si pe linia urmatoare sirul de caractere.
   Rezultatelor vor fi obtinute in fisierul out.txt.

Exemplu

Fisierul int.txt

3
cabababbbabaaa
4
cabababbbabaaa

Fisierul out.txt

DA
ab pozitia 2
b pozitia 7
a pozitia 12

NU
===============================
Solutia 1 (Mihai Stroe)

     Nu s-a dat dimensiunea maxima a sirului; l-am considerat de maxim 255
  caractere,caz in care aceasta rezolvare este satisfacatoare.
     Pentru valori mari ale lui n, se pot introduce optimizari. De  exemplu,
  se elimina simbolurile care apar de mai putin de k ori.
     Nu este clar ce trebuie afisat in cazuri de genul:
     3          sau   3
     aaabaaa          aaaa
  unde sirul 'a' apare de doua ori ca solutie; am considerat ca se vor afisa
  toate aparitiile.
}

var x,i,j,k,l,m,n:longint;
    fi,fo:text;
    s,s1,s2:string;

procedure solve;
begin
  x:=0;
  readln(fi,k);
  readln(fi,s);
  n:=length(s);
  for i:=1 to length(s)do
      for j:=1 to (n-i+1)div k do
          begin
            m:=1;
            s1:=copy(s,i,j);
            for l:=2 to k do
                if copy(s,i+(l-1)*j,j)<>s1 then
                   m:=0;
            if m=1 then
               begin
                 if x=0 then writeln(fo,'DA');
                 x:=1;
                 writeln(fo,s1,' pozitia ',i);
               end;
          end;
  if x=0 then
     writeln(fo,'NU');
  writeln(fo);
end;

begin
  assign(fi,'int.txt');
  assign(fo,'out.txt');
  reset(fi);
  rewrite(fo);
  while not seekeof(fi)do
    solve;
  close(fi);
  close(fo);
end.
--------------------------
Solutia 2 (Bogdan batog)
 Algoritmul are complexitate O(N^3/K^2) cel mai nefavorabil caz (de genu'
 aaaaaaaaaaaaaaa); pe cazul in care solutiile nu se suprapun O(N^2/K)

  fie S sirul nostru
  fie vectorul A de dimensiune N
  L este lungimea secventei cautate care parcurge 1..N/K
    pentru fiecare L se completeaza vectorul A in O(N) astfel:
    A[i]=  A[i-L]+1   daca S[i]=S[i-L]
           1          altfel

  A[i] este egal cu numarul maxim de secvente de lungime L ce preced pozitia
  i si care contin pe pozitia corespunzatoare caracterul S[i]

  pentru fiecare L se determina secventele
  i..i+L-1 pentru care A[p]>=k oricare p intre i si i+L-1
}

var
   fi, fo               :text;
   S                    :array[1..10000] of char;
   A                    :array[1..10000] of integer;
   n,k                  :integer;

Procedure solv;
var L,i,t,f,sol:integer;
begin
     FillChar(A,sizeof(A),0);
     sol:=0;
     for L:=1 to (n div k) do
     begin
       for i:=1 to L do A[i]:=1;
       for i:=L+1 to n do
        if S[i]=S[i-L] then A[i]:=A[i-L]+1
                       else A[i]:=1;
       t:=1;
       repeat
          while (A[t]< k) and (t<=n) do inc(t);
          i:=t+1;
          while (A[i]>=k) and (i<=n) do inc(i);
          dec(i);
          if (i-t+1>=L) and (i<=n) then
          begin
               if sol=0 then begin writeln(fo,'DA'); sol:=1 end;
               for f:=t to t+l-1 do write(fo,S[f]);
               writeln(fo,' pozitia ',t-L*(k-1));
          end;
          if i>t+l-1 then t:=t+1 else t:=i+1;
       until t>n
     end;
     if sol=0 then writeln(fo,'NU');
end;

begin
   assign(fi ,'int.txt');     reset(fi);
   assign(fo ,'out.txt');     rewrite(fo);
   repeat
     readln(fi,k);
     n:=0;
     while not eoln(fi) do
     begin
          inc(n);
          read(fi,S[n]);
     end;
     readln(fi);
     if n>0 then solv;
   until eof(fi);
   close(fi);
   close(fo)
end.
-------------------------
Solutia 3 (Valentin Gheorghita)
{Se rezolva prin programare dinamica;
 Se cauta siruri de lungime 1...trunc(n/k).. n este lungimea sirului.
 Deci sa cautam sirurile de lungime m... Parcurgem de la sf la inceput
 sirul si pt i daca sir(i..i+l-1)=sir(i+l..i+l+l-1) atunci nr[i]:=nr[i+l]+1;
 deci sirul s se repeta de o data mai mult decat inainte; Daca nr de repetari
 este mai mare sau egal cu k atunci tiparim sirul.
 Complexitatea alg este O(n*trunc(n/k)*trunc(n/k))... deci acceptabila...
}

program subsiruri;
uses crt;
type ref=^inr;
     inr=record
          nr:integer;
          s:string;
         end;

var a:array[1..40000] of char;
    c:array[1..5000] of ref;
    f,g:text;
    k,n,i,j:integer;
    gasit:boolean;

procedure citire;
 var nume:string;
 begin
  clrscr;
  write('Introduceti numele fisierului de intrare : ');
  readln(nume);
  assign(f,nume);
  reset(f);
  write('Introduceti numele fisierului de iesire : ');
  readln(nume);
  assign(g,nume);
  rewrite(g);
 end;

procedure citeste;
 begin
  readln(f,k);
  n:=0;
  while not(seekeoln(f)) do
   begin
    n:=n+1;
    read(f,a[n]);
   end;
 end;

procedure cauta(l:integer);
 var i,j:integer;
     s:string;
     pz:integer;
 begin
  for i:=n-l-l+2 to n-l+2 do
   begin
    c[i-n+l+l-1]^.nr:=1;
    c[i-n+l+l-1]^.s:='';
    for j:=1 to l do
     c[i-n+l+l-1]^.s:=c[i-n+l+l-1]^.s+a[i+j-1];
   end;
  pz:=l+1;
  for i:=n-l-l+1 downto 1 do
   begin
    pz:=pz-1;
    if pz=0 then pz:=l;
    s:='';
    for j:=1 to l do
     s:=s+a[i+j-1];
    if s=c[pz]^.s then c[pz]^.nr:=c[pz]^.nr+1
                   else begin
                         c[pz]^.nr:=1;
                         c[pz]^.s:=s;
                        end;
    if c[pz]^.nr>=k then begin
                          if not(gasit) then writeln(g,'DA');
                          writeln(g,s,' pozitia ',i);
                          gasit:=true;
                         end;
   end;
 end;

begin
 clrscr;
 citire;
 while(not(seekeof(f))) do
  begin
   citeste;
   gasit:=false;
   for i:=trunc(n/k) downto 1 do
    begin
     for j:=1 to i do
      new(c[j]);
     cauta(i);
     for j:=1 to i do
      dispose(c[j]);
    end;
   if not(gasit) then writeln(g,'NU');
  end;
 close(f);
 close(g);
end.
------------------------------
Solutia 4 (Angel Proorocu)
  -determin numarul maxim de caractere (l) pe care le poate avea un subsir;
  -vectorul A reprezinta sirul de caractere iar vectorul B are semnificatia:
     b[i]=numarul de subsiruri cu lungimea L ce se pot forma incepand cu a[i];
  -Acest vector este construit de procedura GETB,ce are ca parametru de intrare
  numarul L (L=1..k);
 -La fiecare pas, cand gasesc b[i]>=k, afisez i si subsirul aferent;
program SubsiruriAdiacente;
   uses Crt,Dos;
   var a:array[1..10000]of char;
       b:array[1..10000]of integer;
       n,k:integer;
       f,g:text;
       nou:boolean;
       h,mi,s,hu:word;
procedure Control;forward;
procedure ReadData;
   begin
     assign(f,'int.txt');
     reset(f);
     assign(g,'out.txt');
     rewrite(g);
     while not seekeof(f) do
      begin
        readln(f,k);
        n:=0;
        while not seekeoln(f) do
         begin
          inc(n);
          read(f,a[n]);
        end;
       Control;
       writeln(g);
      end;
     close(f);
     close(g);
   end;

procedure GetB(fr:integer);
   var i,j:integer;
       sw:boolean;
   begin
       for i:=n downto 1 do
        begin
          if i+fr>n then b[i]:=1
           else if i+2*fr-1>n then b[i]:=1
            else
             begin
               sw:=true;
               for j:=i to i+fr-1 do if a[j]<>a[j+fr] then sw:=false;
               if sw then b[i]:=b[i+fr]+1
                     else b[i]:=1;
             end;
          if b[i]>=k then
            begin
              if nou then begin nou:=false; writeln(g,'DA');  end;
              for j:=i to i+fr-1 do write(g,a[j]);
              writeln(g,'  pozitia ',i);
            end;
        end;
   end;

procedure Control;
   var i:integer;
   begin
      nou:=true;
      for i:=1 to n div k do GetB(i);
      if nou then writeln(g,'NU');
   end;

begin
  Settime(0,0,0,0);
  Clrscr;
  ReadData;
  Writeln('Am terminat...Rezultatul in OUT.TXT...');
  Gettime(h,mi,s,hu);
  writeln('Timp aprox.....',h,':',mi,':',s,':',hu);
  Readkey;
end.
-------------------------
Solutia 5 (Tudor Leu)
uses crt;
var fi,fo:text;
    s,s1,s2:string;
    i,j,k,l,n,sw:word;
begin
     assign(fi,'int.txt');assign(fo,'out.txt');
     reset(fi);rewrite(fo);
     while not(seekeof(fi)) do begin
         readln(fi,k);readln(fi,s);
         sw:=0;n:=length(s);
         for i:=1 to n-k+1 do
            for j:=1 to (n-i+1) div k do begin
               s1:=copy(s,i,j);
               s2:=copy(s,i+j,j);
               l:=2;
               while (l<k) and (s1=s2) do begin
                   s2:=copy(s,i+l*j,j);
                   l:=l+1;
               end;
               if s1=s2 then begin sw:=sw+1;
                                   if sw=1 then writeln(fo,'DA');
                                   writeln(fo,s1,' pozitia ',i);
                             end;
            end;
         if sw=0 then writeln(fo,'NU');
         writeln(fo);
     end;
     close(fi);close(fo);
end.
------------------------------
